home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Module source / PopupMenuMod.txt < prev    next >
Encoding:
Text File  |  1994-05-08  |  2.7 KB  |  110 lines  |  [TEXT/MSET]
  1. \ Class PopupMenu.  This version handles pop-up menus in dialogs.  If we
  2. \ ever need one somewhere else, we'll have to define a subclass with
  3. \ different HIT: and NORMAL: methods.
  4.  
  5.  
  6. objPtr    THEDLG        class_is dialog+
  7.  
  8.  
  9. :class POPUPMENU    super{ menu }
  10. record
  11. {    string+    ITEMTEXT    \ Current text displayed in pop-up box
  12.     int        ITEM#        \ Current item # displayed in pop-up box
  13.     int        BOX#        \ Dialog item# of pop-up box
  14.     int        TITLE#        \ Dialog item# of pop-up title
  15.     rect    TITLERECT
  16.     rect    POPUPBOX
  17.     dicAddr    ^DLG        \ Points to owning dialog
  18.     ptr        F-LINK        \ Forward link for chain of pop-up menus
  19.                         \  belonging to the one dialog
  20. }
  21.  
  22. :m GETTEXT:        ( -- addr len )    get: itemText  ;m
  23. :m ITEM#:        ( -- item# )    get: item#   ;m
  24. :m PUTITEM#:    ( item# -- )    put: item#   ;m
  25. :m PUTTITLE#:    ( title# -- )    put: title#  ;m
  26. :m PUT^DLG:        ( ^dlg -- )    put: ^dlg  ;m
  27. :m F-LINK:        get: F-link  ;m
  28. :m SET-F-LINK:    put: F-link  ;m
  29. :m BOX#:        get: box#  ;m
  30.  
  31. private
  32.  
  33. :m CHKDLG:    \ ( -- b )
  34.     get: ^dlg  this_dlg  =  ;m
  35.  
  36. :m DT:
  37.     chkDlg: self  0EXIT
  38.     get: itemtext  addr: popUpBox  1 makeint call textBox  ;m
  39.  
  40. public
  41.  
  42. :m INIT:    \ ( cfa-list resid box# title# -- )
  43.     put: title#  put: box#  init: super  ;m
  44.  
  45. :m GETNEW:
  46.     new: itemText  getNew: super
  47.     get: Mhndl  -1 makeint  call InsertMenu  ;m
  48.  
  49. :m NORMAL:
  50.     savePort  dlgPort
  51.     invert: titleRect
  52.     restPort  ;m
  53.  
  54.  
  55. :m DRAWTEXT:
  56.     chkDlg: self  0EXIT
  57.     savePort  dlgPort  dt: self
  58.     restPort  ;m
  59.  
  60. :m PUTTEXT:        \ ( addr len -- )  Doesn't draw the text, since THIS_DLG
  61.                 \ may not be valid.
  62.     put: itemText  ;m
  63.  
  64.  
  65. :m DRAWBOX:        \ Called from DRAWBOX, which is called from PUboxProc.
  66.     chkDlg: self  0EXIT
  67.     get: box#  itemHandle: this_dlg  drop
  68.     tempRect ->: popUpBox
  69.     dropShadow: popUpBox
  70.     getBotX: popUpBox  19 -
  71.     getTopY: popUpBox   6 +  moveto  del
  72.     1 1 inset: popUpBox  getBotX: popUpBox  20 -  putBotX: popUpBox
  73.                     \ So box outline and down arrow aren't wiped
  74.     dt: self  ;m
  75.  
  76.  
  77. :m HIT:
  78.     get: title#  itemHandle: this_dlg drop
  79.     tempRect ->: titleRect
  80.     savePort  dlgPort
  81.     invert: titleRect
  82.     get: theItem  itemHandle: this_dlg  drop    \ Set TempRect to pop-up box
  83.     0
  84.     get: Mhndl
  85.     topint: tempRect  l->g  unpack swap pack
  86.     get: item# 1+  makeint
  87.     call PopUpMenuSelect
  88.     unpack  drop  1-                    \ our item# - one less than Toolbox's
  89.     dup 0>=
  90.     IF    dup getitem: super  putText: self  dt: self
  91.         restPort
  92.         dup exec: super                    \ Execute action handler
  93.                 \ Note: the old item# is still in the item# field, but the
  94.                 \ new one is on the stack.  This should be useful when we
  95.                 \ need to know if the item# is being changed.
  96.         put: item#
  97.     ELSE
  98.         drop  restPort
  99.     THEN
  100.     normal: self  ;m
  101.  
  102. :m LINK:    \ ( ^dlg -- )
  103.     -> theDlg
  104.     theDlg  put^dlg: self
  105.     ['] PUboxProc  get: box#  setUserProc: theDlg
  106.     PUM-link: theDlg  put: F-link
  107.     ^base  set-PUM-link: theDlg  ;m
  108.  
  109. ;class
  110.